home *** CD-ROM | disk | FTP | other *** search
/ Aminet 3 / Aminet 3 - July 1994.iso / Aminet / dev / m2 / Modules.lha / Modules / Simple3D / Simple3D.mod / Simple3D.mod
Encoding:
Modula Implementation  |  1993-12-22  |  29.0 KB  |  1,157 lines
  1. IMPLEMENTATION MODULE Simple3D;
  2.  
  3. (* Die Erklärung der Funktionen und Hinweise befinden sich im Definitionsfile *)
  4. (* Compiler : M2Amiga 4.097d                         © 1991 by Andre Wiethoff *)
  5.  
  6.  
  7. (*$ StackChk:=FALSE *)
  8. (*$ RangeChk:=FALSE *)
  9. (*$ OverflowChk:=FALSE *)
  10. (*$ NilChk:=FALSE *)
  11. (*$ CaseChk:=FALSE *)
  12. (*$ ReturnChk:=FALSE *)
  13. (*$ Volatile:=FALSE *)
  14. (*$ StackParms:=FALSE *)
  15. (*$ LargeVars:=FALSE *)
  16.  
  17.  
  18. FROM SYSTEM       IMPORT FFP,ASSEMBLE,ADR,ADDRESS;
  19. FROM GraphicsL    IMPORT Draw,Move,SetAPen,InitArea,AreaMove,AreaDraw,
  20.                          InitTmpRas,AllocRaster,FreeRaster,AreaEnd;
  21. FROM GraphicsD    IMPORT RastPortPtr,AreaInfo,RastPort,
  22.                          AreaInfoPtr,TmpRas,TmpRasPtr,RastPortFlags;
  23. FROM RememberHeap IMPORT NewAllocRemember,NewFreeRemember,NewRememberPtr,
  24.                          CutRememberStructure,GetAddress;
  25. FROM IntuitionL   IMPORT AllocRemember,FreeRemember;
  26. FROM IntuitionD   IMPORT RememberPtr;
  27. FROM ExecD        IMPORT MemReqSet,MemReqs;
  28. FROM Heap         IMPORT AllocMem,Deallocate,Available;
  29. FROM MathTrans    IMPORT Atan,Sqrt;
  30. FROM MathFFP      IMPORT Cmp;
  31. IMPORT GraphicsL;
  32. IMPORT MathFFP;
  33.  
  34.  
  35.  
  36. (*$ EntryExitCode:=FALSE *)
  37. PROCEDURE SinusTable;  (* FFP *)
  38. BEGIN
  39.   ASSEMBLE(
  40.     DC.L $00000000,$8EF85A3B,$8EF2D53C,$D65E573C,$8EDC6F3D
  41.     DC.L $B27EB13D,$D613073D,$F996AC3D,$8E836D3E,$A030573E
  42.     DC.L $B1D0D43E,$C363733E,$D4E6CC3E,$E659943E,$F7BA663E
  43.     DC.L $8483EB3F,$8D20553F,$95B1BF3F,$9E377C3F,$A6B0DC3F
  44.     DC.L $AF1D433F,$B77C023F,$BFCC723F,$C80DE63F,$D03FC83F
  45.     DC.L $D8616C3F,$E0722D3F,$E871723F,$F05E963F,$F838FB3F
  46.     DC.L $FFFFFE3F,$83D98940,$87A8CB40,$8B6D7840,$8F274340
  47.     DC.L $92D5E740,$96791840,$9A108D40,$9D9BFF40,$A11B2340
  48.     DC.L $A48DBC40,$A7F37B40,$AB4C2440,$AE977240,$B1D52340
  49.     DC.L $B504F240,$B826A740,$BB3A0040,$BE3EBE40,$C134A540
  50.     DC.L $C41B7D40,$C6F30940,$C9BB1240,$CC736140,$CF1BBE40
  51.     DC.L $D1B3F240,$D43BCE40,$D6B31D40,$D919AE40,$DB6F5240
  52.     DC.L $DDB3D740,$DFE71340,$E208DB40,$E4190140,$E6175F40
  53.     DC.L $E803C940,$E9DE1D40,$EBA63440,$ED5BEC40,$EEFF2140
  54.     DC.L $F08FB140,$F20D8140,$F3787140,$F4D06440,$F6154040
  55.     DC.L $F746EA40,$F8654D40,$F9705240,$FA67E240,$FB4BEC40
  56.     DC.L $FC1C5D40,$FCD92540,$FD823540,$FE178240,$FE98FD40
  57.     DC.L $FF069E40,$FF605C40,$FFA63040,$FFD81440,$FFF60540
  58.     DC.L $80000041,$FFF60540,$FFD81440,$FFA63040,$FF605C40
  59.     DC.L $FF069E40,$FE98FD40,$FE178240,$FD823640,$FCD92540
  60.     DC.L $FC1C5D40,$FB4BED40,$FA67E240,$F9705240,$F8654E40
  61.     DC.L $F746EB40,$F6154040,$F4D06440,$F3787140,$F20D8240
  62.     DC.L $F08FB340,$EEFF2240,$ED5BED40,$EBA63640,$E9DE1E40
  63.     DC.L $E803CC40,$E6175F40,$E4190240,$E208DB40,$DFE71640
  64.     DC.L $DDB3D940,$DB6F5240,$D919B040,$D6B32040,$D43BD040
  65.     DC.L $D1B3F640,$CF1BBD40,$CC736340,$C9BB1240,$C6F30B40
  66.     DC.L $C41B7F40,$C134A740,$BE3EBE40,$BB3A0040,$B826AA40
  67.     DC.L $B504F540,$B1D52340,$AE977540,$AB4C2440,$A7F37E40
  68.     DC.L $A48DBF40,$A11B2640,$9D9C0240,$9A108D40,$96791C40
  69.     DC.L $92D5E740,$8F274640,$8B6D7B40,$87A8CB40,$83D98C40
  70.     DC.L $80000640,$F838FA3F,$F05E963F,$E871713F,$E072353F
  71.     DC.L $D8616C3F,$D03FD03F,$C80DF53F,$BFCC723F,$B77C023F
  72.     DC.L $AF1D423F,$A6B0E43F,$9E377C3F,$95B1C73F,$8D20553F
  73.     DC.L $8483EC3F,$F7BA663E,$E659A43E,$D4E6DB3E,$C363733E
  74.     DC.L $B1D0D43E,$A030573E,$8E837C3E,$F996AC3D,$D613273D
  75.     DC.L $B27ED13D,$8EDC6F3D,$D65E5B3C,$8EF2D73C,$8EF8D83B
  76.     DC.L $00000000,$8EF7D9BB,$8EF296BC,$D65E1BBC,$8EDC6FBD
  77.     DC.L $B27EB1BD,$D612E8BD,$F9968CBD,$8E835DBE,$A03057BE
  78.     DC.L $B1D0C4BE,$C36373BE,$D4E6DBBE,$E65984BE,$F7BA47BE
  79.     DC.L $8483ECBF,$8D2055BF,$95B1B8BF,$9E377CBF,$A6B0D5BF
  80.     DC.L $AF1D3BBF,$B77BFABF,$BFCC6BBF,$C80DE7BF,$D03FC8BF
  81.     DC.L $D8616CBF,$E07226BF,$E8716BBF,$F05E8FBF,$F838F3BF
  82.     DC.L $FFFFFEBF,$83D989C0,$87A8CBC0,$8B6D71C0,$8F2743C0
  83.     DC.L $92D5E4C0,$967918C0,$9A108DC0,$9D9BFCC0,$A11B20C0
  84.     DC.L $A48DB6C0,$A7F37BC0,$AB4C21C0,$AE9772C0,$B1D520C0
  85.     DC.L $B504F2C0,$B826A4C0,$BB39FDC0,$BE3EBCC0,$C134A5C0
  86.     DC.L $C41B7AC0,$C6F30BC0,$C9BB12C0,$CC7361C0,$CF1BBBC0
  87.     DC.L $D1B3EFC0,$D43BD0C0,$D6B31EC0,$D919ACC0,$DB6F50C0
  88.     DC.L $DDB3D5C0,$DFE710C0,$E208DBC0,$E41900C0,$E6175DC0
  89.     DC.L $E803CAC0,$E9DE1BC0,$EBA634C0,$ED5BECC0,$EEFF20C0
  90.     DC.L $F08FB0C0,$F20D82C0,$F37871C0,$F4D063C0,$F6153EC0
  91.     DC.L $F746E9C0,$F8654DC0,$F97052C0,$FA67E2C0,$FB4BEDC0
  92.     DC.L $FC1C5CC0,$FCD924C0,$FD8236C0,$FE1781C0,$FE98FDC0
  93.     DC.L $FF069EC0,$FF605CC0,$FFA630C0,$FFD814C0,$FFF605C0
  94.     DC.L $800000C1,$FFF605C0,$FFD815C0,$FFA630C0,$FF605DC0
  95.     DC.L $FF069FC0,$FE98FDC0,$FE1782C0,$FD8237C0,$FCD925C0
  96.     DC.L $FC1C5EC0,$FB4BECC0,$FA67E3C0,$F97052C0,$F8654FC0
  97.     DC.L $F746EBC0,$F61540C0,$F4D065C0,$F37873C0,$F20D85C0
  98.     DC.L $F08FB3C0,$EEFF22C0,$ED5BEDC0,$EBA634C0,$E9DE22C0
  99.     DC.L $E803CEC0,$E6175FC0,$E41903C0,$E208DEC0,$DFE713C0
  100.     DC.L $DDB3DCC0,$DB6F54C0,$D919B1C0,$D6B322C0,$D43BCEC0
  101.     DC.L $D1B3F4C0,$CF1BC0C0,$CC7363C0,$C9BB17C0,$C6F310C0
  102.     DC.L $C41B7FC0,$C134A7C0,$BE3EC1C0,$BB3A00C0,$B826ACC0
  103.     DC.L $B504F5C0,$B1D526C0,$AE9775C0,$AB4C24C0,$A7F37EC0
  104.     DC.L $A48DBCC0,$A11B2AC0,$9D9C02C0,$9A1094C0,$967918C0
  105.     DC.L $92D5EAC0,$8F2749C0,$8B6D75C0,$87A8CBC0,$83D989C0
  106.     DC.L $FFFFF7BF,$F83910BF,$F05E9DBF,$E87180BF,$E07243BF
  107.     DC.L $D86173BF,$D03FD7BF,$C80DF5BF,$BFCC72BF,$B77C09BF
  108.     DC.L $AF1D4ABF,$A6B0DCBF,$9E377CBF,$95B1BFBF,$8D206DBF
  109.     DC.L $848402BF,$F7BA75BE,$E659B3BE,$D4E6EBBE,$C36373BE
  110.     DC.L $B1D0E4BE,$A03076BE,$8E835DBE,$F996ACBD,$D61327BD
  111.     DC.L $B27ED1BD,$8EDC6FBD,$D65E57BC,$8EF354BC,$8EF9DCBB
  112.   END);
  113. END SinusTable;
  114.  
  115.  
  116.  
  117. VAR sinus : POINTER TO ARRAY[0..359] OF FFP;
  118.  
  119. PROCEDURE Sin(w : LONGINT) : FFP;
  120. BEGIN
  121.   RETURN sinus^[w MOD 360];
  122. END Sin;
  123.  
  124.  
  125.  
  126. PROCEDURE Cos(w : LONGINT) : FFP;
  127. BEGIN
  128.   RETURN sinus^[(w+90) MOD 360];
  129. END Cos;
  130.  
  131.  
  132.  
  133. VAR rememberObject  : NewRememberPtr;
  134.     rememberDisplay : NewRememberPtr;
  135.  
  136. PROCEDURE InitObject() : ObjectHandlePtr;
  137. VAR obj : ObjectHandlePtr;
  138. BEGIN
  139.   obj:=NewAllocRemember(rememberObject,SIZE(ObjectHandle),FALSE);
  140.   IF obj#NIL THEN
  141.     WITH obj^ DO
  142.       firstArea:=NIL;
  143.       rememberData:=NIL;
  144.       rotX:=0; rotY:=0; rotZ:=0;
  145.       WITH trans DO
  146.         x:=0.0; y:=0.0; z:=0.0;
  147.       END;
  148.     END;
  149.   END;
  150.   RETURN obj;
  151. END InitObject;
  152.  
  153.  
  154.  
  155. PROCEDURE AddPoint(    object : ObjectHandlePtr;
  156.                    VAR area   : AreaPtr;
  157.                        x,y,z  : FFP);
  158. VAR t : AreaPtr;
  159.     c : INTEGER;
  160. BEGIN
  161.   IF object#NIL THEN
  162.     IF area=NIL THEN
  163.       area:=AllocRemember(object^.rememberData,SIZE(Area),
  164.                           MemReqSet{memClear});
  165.       t:=area;
  166.     ELSE
  167.       t:=area; c:=1;
  168.       WHILE t^.nextPoint#NIL DO t:=t^.nextPoint; INC(c); END;
  169.       IF c<255 THEN
  170.         t^.nextPoint:=AllocRemember(object^.rememberData,SIZE(Area),
  171.                                     MemReqSet{memClear});
  172.       END;
  173.       t:=t^.nextPoint;
  174.     END;
  175.     IF t#NIL THEN
  176.       t^.point.x:=x;
  177.       t^.point.y:=y;
  178.       t^.point.z:=z;
  179.     END;
  180.   END;
  181. END AddPoint;
  182.  
  183.  
  184.  
  185. PROCEDURE AddArea(object : ObjectHandlePtr;
  186.                   area   : AreaPtr;
  187.                   lc,ic  : INTEGER);
  188. VAR obj,t : ObjectPtr;
  189. BEGIN
  190.   IF object#NIL THEN
  191.     obj:=object^.firstArea;
  192.     IF obj=NIL THEN
  193.       obj:=AllocRemember(object^.rememberData,SIZE(Object),
  194.                          MemReqSet{memClear});
  195.       t:=obj;
  196.     ELSE
  197.       t:=obj;
  198.       WHILE t^.nextArea#NIL DO t:=t^.nextArea; END;
  199.       t^.nextArea:=AllocRemember(object^.rememberData,SIZE(Object),
  200.                          MemReqSet{memClear});
  201.       t:=t^.nextArea;
  202.     END;
  203.     IF t#NIL THEN
  204.       t^.firstPoint:=area;
  205.       t^.lineColor:=lc;
  206.       t^.innerColor:=ic;
  207.     END;
  208.     object^.firstArea:=obj;
  209.   END;
  210. END AddArea;
  211.  
  212.  
  213.  
  214. PROCEDURE GetRect(object       : ObjectHandlePtr;
  215.                   x1,y1, x2,y2 : FFP) : AreaPtr;
  216. VAR area : AreaPtr;
  217. BEGIN
  218.   area:=NIL;
  219.   AddPoint(object,area,x1,y1,0.0);
  220.   AddPoint(object,area,x2,y1,0.0);
  221.   AddPoint(object,area,x2,y2,0.0);
  222.   AddPoint(object,area,x1,y2,0.0);
  223.   RETURN area;
  224. END GetRect;
  225.  
  226.  
  227.  
  228. PROCEDURE GetCircle(object : ObjectHandlePtr;
  229.                     mx,my  : FFP;
  230.                     r      : FFP;
  231.                     num    : INTEGER;
  232.                     deg    : INTEGER) : AreaPtr;
  233. VAR area : AreaPtr;
  234.     t    : INTEGER;
  235.     w    : LONGINT;
  236. BEGIN
  237.   IF deg>360 THEN deg:=360; END;
  238.   IF deg>=0 THEN
  239.     area:=NIL;
  240.     FOR t:=0 TO num DO
  241.       w:=(LONGINT(t)*deg)/LONGINT(num);
  242.       AddPoint(object,area,mx+r*Sin(w),my+r*Cos(w),0.0);
  243.     END;
  244.   END;
  245.   RETURN area;
  246. END GetCircle;
  247.  
  248.  
  249.  
  250. PROCEDURE CopyArea(object : ObjectHandlePtr;
  251.                    area   : AreaPtr) : AreaPtr;
  252. VAR a,b,t : AreaPtr;
  253. BEGIN
  254.   IF object#NIL THEN
  255.     a:=NIL;
  256.     IF area#NIL THEN
  257.       a:=AllocRemember(object^.rememberData,SIZE(Area),MemReqSet{memClear});
  258.       IF a#NIL THEN
  259.         t:=a;
  260.         a^.point:=area^.point; a^.nextPoint:=NIL;
  261.         WHILE area^.nextPoint#NIL DO
  262.           t^.nextPoint:=AllocRemember(object^.rememberData,SIZE(Area),
  263.                                       MemReqSet{memClear});
  264.           area:=area^.nextPoint;
  265.           IF t^.nextPoint#NIL THEN
  266.             t:=t^.nextPoint;
  267.             t^.point:=area^.point;
  268.           END;
  269.         END;
  270.       END;
  271.     END;
  272.   END;
  273.   RETURN a;
  274. END CopyArea;
  275.  
  276.  
  277.  
  278. PROCEDURE RotateArea(area     : AreaPtr;
  279.                      rx,ry,rz : INTEGER);
  280. VAR f11,f12,f13,f21,f22,f23,f31,f32,f33 : FFP;
  281.     cx,cy,cz,sx,sy,sz : FFP;
  282. BEGIN
  283.   cx:=Cos(rx);
  284.   sx:=Sin(rx);
  285.   cy:=Cos(ry);
  286.   sy:=Sin(ry);
  287.   cz:=Cos(rz);
  288.   sz:=Sin(rz);
  289.   f11:=cy*cz; f12:=cy*sz; f13:=-sy;
  290.   f21:=sx*sy*cz-cx*sz; f22:=sx*sy*sz+cx*cz; f23:=sx*cy;
  291.   f31:=cx*sy*cz+sx*sz; f32:=cx*sy*sz-sx*cz; f33:=cx*cy;
  292.   WHILE area#NIL DO
  293.     WITH area^.point DO
  294.       x:=x*f11+y*f12+z*f13;
  295.       y:=x*f21+y*f22+z*f23;
  296.       z:=x*f31+y*f32+z*f33;
  297.     END;
  298.     area:=area^.nextPoint;
  299.   END;
  300. END RotateArea;
  301.  
  302.  
  303.  
  304. PROCEDURE MoveAreaDirect(area     : AreaPtr;
  305.                          tx,ty,tz : FFP);
  306. BEGIN
  307.   WHILE area#NIL DO
  308.     WITH area^.point DO
  309.       x:=x+tx; y:=y+ty; z:=z+tz;
  310.     END;
  311.     area:=area^.nextPoint;
  312.   END;
  313. END MoveAreaDirect;
  314.  
  315.  
  316.  
  317. PROCEDURE GetCube(x1,y1, x2,y2, h : FFP;
  318.                   lc,ic           : INTEGER) : ObjectHandlePtr;
  319. VAR obj  : ObjectHandlePtr;
  320.     area : AreaPtr;
  321. BEGIN
  322.   obj:=InitObject();
  323.   IF obj#NIL THEN
  324.     area:=GetRect(obj,x1,y1,x2,y2);
  325.     AddArea(obj,area,lc,ic);
  326.     area:=CopyArea(obj,area);
  327.     MoveAreaDirect(area,0.0,0.0,h);
  328.     AddArea(obj,area,lc,ic);
  329.     area:=NIL;
  330.     AddPoint(obj,area,x1,y1,0.0);
  331.     AddPoint(obj,area,x1,y1,h);
  332.     AddPoint(obj,area,x1,y2,h);
  333.     AddPoint(obj,area,x1,y2,0.0);
  334.     AddArea(obj,area,lc,ic);
  335.     area:=CopyArea(obj,area);
  336.     MoveAreaDirect(area,x2-y1,0.0,0.0);
  337.     AddArea(obj,area,lc,ic);
  338.     area:=NIL;
  339.     AddPoint(obj,area,x1,y1,0.0);
  340.     AddPoint(obj,area,x1,y1,h);
  341.     AddPoint(obj,area,x2,y1,h);
  342.     AddPoint(obj,area,x2,y1,0.0);
  343.     AddArea(obj,area,lc,ic);
  344.     area:=CopyArea(obj,area);
  345.     MoveAreaDirect(area,0.0,y2-y1,0.0);
  346.     AddArea(obj,area,lc,ic);
  347.   END;
  348.   RETURN obj;
  349. END GetCube;
  350.  
  351.  
  352.  
  353. PROCEDURE GetPyramid(x1,y1, x2,y2, h : FFP;
  354.                      lc,ic           : INTEGER) : ObjectHandlePtr;
  355. VAR obj  : ObjectHandlePtr;
  356.     area : AreaPtr;
  357. BEGIN
  358.   obj:=InitObject();
  359.   IF obj#NIL THEN
  360.     area:=GetRect(obj,x1,y1,x2,y2);
  361.     AddArea(obj,area,lc,ic);
  362.     area:=NIL;
  363.     AddPoint(obj,area,x1,y1,0.0);
  364.     AddPoint(obj,area,(x1+x2)/2.0,(y1+y2)/2.0,h);
  365.     AddPoint(obj,area,x2,y1,0.0);
  366.     AddArea(obj,area,lc,ic);
  367.     area:=NIL;
  368.     AddPoint(obj,area,x2,y1,0.0);
  369.     AddPoint(obj,area,(x1+x2)/2.0,(y1+y2)/2.0,h);
  370.     AddPoint(obj,area,x2,y2,0.0);
  371.     AddArea(obj,area,lc,ic);
  372.     area:=NIL;
  373.     AddPoint(obj,area,x2,y2,0.0);
  374.     AddPoint(obj,area,(x1+x2)/2.0,(y1+y2)/2.0,h);
  375.     AddPoint(obj,area,x1,y2,0.0);
  376.     AddArea(obj,area,lc,ic);
  377.     area:=NIL;
  378.     AddPoint(obj,area,x1,y2,0.0);
  379.     AddPoint(obj,area,(x1+x2)/2.0,(y1+y2)/2.0,h);
  380.     AddPoint(obj,area,x1,y1,0.0);
  381.     AddArea(obj,area,lc,ic);
  382.   END;
  383.   RETURN obj;
  384. END GetPyramid;
  385.  
  386.  
  387.  
  388. PROCEDURE GetRotationObject(area  : AreaPtr;
  389.                             num   : INTEGER;
  390.                             flags : RotationFlagSet;
  391.                             lc,ic : INTEGER) : ObjectHandlePtr;
  392. VAR a,b,na : AreaPtr;
  393.     obj    : ObjectHandlePtr;
  394.     t   : INTEGER;
  395.     w   : LONGINT;
  396.     x1,x2,y1,y2,z1,z2,wi : FFP;
  397.     ox1,oz1,ox2,oz2      : FFP;
  398.     nx1,nz1,nx2,nz2      : FFP;
  399.     fl : BOOLEAN;
  400. BEGIN
  401.   fl:=TRUE;
  402.   obj:=InitObject();
  403.   IF (area#NIL) AND (obj#NIL) THEN
  404.     a:=area;
  405.     WHILE a#NIL DO
  406.       b:=a^.nextPoint;
  407.       IF b=NIL THEN
  408.         b:=area;
  409.         IF notClosed IN flags THEN
  410.           fl:=FALSE;
  411.         END;
  412.         na:=NIL;
  413.         IF bottomClosed IN flags THEN
  414.           WITH a^.point DO
  415.             x1:=x;
  416.             y1:=y;
  417.           END;
  418.           FOR t:=1 TO num DO
  419.             w:=(t*360)/num;
  420.             wi:=Cos(w);
  421.             nx1:=x1*wi;
  422.             wi:=Sin(w);
  423.             nz1:=x1*wi;
  424.             AddPoint(obj,na,nx1,y1,nz1);
  425.           END;
  426.           AddArea(obj,na,lc,ic);
  427.         END;
  428.         na:=NIL;
  429.         IF topClosed IN flags THEN
  430.           WITH b^.point DO
  431.             x1:=x;
  432.             y1:=y;
  433.           END;
  434.           FOR t:=1 TO num DO
  435.             w:=(t*360)/num;
  436.             wi:=Cos(w);
  437.             nx1:=x1*wi;
  438.             wi:=Sin(w);
  439.             nz1:=x1*wi;
  440.             AddPoint(obj,na,nx1,y1,nz1);
  441.           END;
  442.           AddArea(obj,na,lc,ic);
  443.         END;
  444.       END;
  445.       IF fl THEN
  446.         WITH a^.point DO
  447.           x1:=x; y1:=y;
  448.           ox1:=x; oz1:=0.0;
  449.         END;
  450.         WITH b^.point DO
  451.           x2:=x; y2:=y;
  452.           ox2:=x; oz2:=0.0;
  453.         END;
  454.         FOR t:=1 TO num DO
  455.           na:=NIL;
  456.           w:=(t*360)/num;
  457.           wi:=Cos(w);
  458.           nx1:=x1*wi;
  459.           nx2:=x2*wi;
  460.           wi:=Sin(w);
  461.           nz1:=x1*wi;
  462.           nz2:=x2*wi;
  463.           AddPoint(obj,na,ox1,y1,oz1);
  464.           AddPoint(obj,na,ox2,y2,oz2);
  465.           AddPoint(obj,na,nx2,y2,nz2);
  466.           AddPoint(obj,na,nx1,y1,nz1);
  467.           AddArea(obj,na,lc,ic);
  468.           ox1:=nx1; ox2:=nx2; oz1:=nz1; oz2:=nz2;
  469.         END;
  470.       END;
  471.       a:=a^.nextPoint;
  472.     END;
  473.   END;
  474.   RETURN obj;
  475. END GetRotationObject;
  476.  
  477.  
  478.  
  479. PROCEDURE GetSphere(mx,my,mz  : FFP;
  480.                     r         : FFP;
  481.                     numV,numH : INTEGER;
  482.                     lc,ic     : INTEGER) : ObjectHandlePtr;
  483. VAR area      : AreaPtr;
  484.     obj1,obj2 : ObjectHandlePtr;
  485. BEGIN
  486.   obj1:=InitObject();
  487.   IF obj1#NIL THEN
  488.     area:=GetCircle(obj1,0.0,0.0,r,numV,180);
  489.     IF area#NIL THEN
  490.       obj2:=GetRotationObject(area,numH,
  491.                               RotationFlagSet{notClosed},lc,ic);
  492.       FreeRemember(ADR(obj1^.rememberData),TRUE);
  493.       CutRememberStructure(rememberObject,obj1,TRUE);
  494.       WITH obj2^.trans DO
  495.         x:=mx; y:=my; z:=mz;
  496.       END;
  497.     END;
  498.   END;
  499.   RETURN obj2;
  500. END GetSphere;
  501.  
  502.  
  503.  
  504. PROCEDURE CopyObject(obj : ObjectHandlePtr) : ObjectHandlePtr;
  505. VAR o     : ObjectHandlePtr;
  506.     a,b,c : ObjectPtr;
  507. BEGIN
  508.   o:=NIL;
  509.   IF obj#NIL THEN
  510.     o:=NewAllocRemember(rememberObject,SIZE(ObjectHandle),FALSE);
  511.     IF o#NIL THEN
  512.       o^:=obj^;
  513.       WITH o^ DO
  514.         firstArea:=NIL;
  515.         rememberData:=NIL;
  516.       END;
  517.       b:=obj^.firstArea;
  518.       c:=NIL;
  519.       WHILE b#NIL DO
  520.         a:=AllocRemember(o^.rememberData,SIZE(Object),MemReqSet{memClear});
  521.         IF a#NIL THEN
  522.           a^:=b^;
  523.           IF b=obj^.firstArea THEN o^.firstArea:=a; END;
  524.           a^.firstPoint:=CopyArea(o,b^.firstPoint);
  525.           IF c#NIL THEN
  526.             c^.nextArea:=a;
  527.           END;
  528.           c:=a;
  529.         END;
  530.         b:=b^.nextArea;
  531.       END;
  532.     END;
  533.   END;
  534.   RETURN o;
  535. END CopyObject;
  536.  
  537.  
  538.  
  539. PROCEDURE MoveObject(obj      : ObjectHandlePtr;
  540.                      tx,ty,tz : FFP);
  541. BEGIN
  542.   IF obj#NIL THEN
  543.     WITH obj^.trans DO
  544.       x:=x+tx; y:=y+ty; z:=z+tz;
  545.     END;
  546.   END;
  547. END MoveObject;
  548.  
  549.  
  550.  
  551. PROCEDURE MoveObjectDirect(obj      : ObjectHandlePtr;
  552.                            tx,ty,tz : FFP);
  553. VAR o : ObjectPtr;
  554. BEGIN
  555.   IF obj#NIL THEN
  556.     o:=obj^.firstArea;
  557.     WHILE o#NIL DO
  558.       MoveAreaDirect(o^.firstPoint,tx,ty,tz);
  559.       o:=o^.nextArea;
  560.     END;
  561.   END;
  562. END MoveObjectDirect;
  563.  
  564.  
  565.  
  566. PROCEDURE RotateObject(obj      : ObjectHandlePtr;
  567.                        rx,ry,rz : INTEGER);
  568. VAR a : AreaPtr;
  569. BEGIN
  570.   IF obj#NIL THEN
  571.     WITH obj^ DO
  572.       rotX:=rotX+rx; rotY:=rotY+ry; rotZ:=rotZ+rz;
  573.     END;
  574.   END;
  575. END RotateObject;
  576.  
  577.  
  578.  
  579. PROCEDURE GetObjectPosition(obj          : ObjectHandlePtr;
  580.                             VAR px,py,pz : FFP);
  581. BEGIN
  582.   IF obj#NIL THEN
  583.     WITH obj^.trans DO
  584.       px:=x; py:=y; pz:=z;
  585.     END;
  586.   END;
  587. END GetObjectPosition;
  588.  
  589.  
  590.  
  591. PROCEDURE GetObjectRotation(obj          : ObjectHandlePtr;
  592.                             VAR rx,ry,rz : INTEGER);
  593. BEGIN
  594.   IF obj#NIL THEN
  595.     WITH obj^ DO
  596.       rx:=rotX; ry:=rotY; rz:=rotZ;
  597.     END;
  598.   END;
  599. END GetObjectRotation;
  600.  
  601.  
  602.  
  603. PROCEDURE InitDisplay() : DisplayPtr;
  604. VAR dp : DisplayPtr;
  605. BEGIN
  606.   dp:=NewAllocRemember(rememberDisplay,SIZE(Display),FALSE);
  607.   IF dp#NIL THEN
  608.     WITH dp^ DO
  609.       firstObject:=NIL;
  610.       cameraPos.x:=0.0; cameraPos.y:=0.0; cameraPos.z:=500.0;
  611.       viewPos.x:=0.0; viewPos.y:=0.0; viewPos.z:=0.0;
  612.       distanceScreen:=200.0;
  613.     END;
  614.   END;
  615.   RETURN dp;
  616. END InitDisplay;
  617.  
  618.  
  619.  
  620. PROCEDURE AddObject(display : DisplayPtr;
  621.                     object  : ObjectHandlePtr);
  622. VAR obj,t : ObjectHandlePtr;
  623. BEGIN
  624.   IF (display#NIL) AND (object#NIL) THEN
  625.     obj:=display^.firstObject;
  626.     object^.nextObject:=NIL;
  627.     IF obj=NIL THEN
  628.       display^.firstObject:=object;
  629.     ELSE
  630.       t:=obj;
  631.       WHILE t^.nextObject#NIL DO t:=t^.nextObject; END;
  632.       t^.nextObject:=object;
  633.     END;
  634.   END;
  635. END AddObject;
  636.  
  637.  
  638.  
  639. PROCEDURE SetCamera(display  : DisplayPtr;
  640.                     px,py,pz : FFP;
  641.                     vx,vy,vz : FFP;
  642.                     dist     : FFP);
  643. BEGIN
  644.   IF display#NIL THEN
  645.     WITH display^.cameraPos DO
  646.       x:=px; y:=py; z:=pz;
  647.     END;
  648.     WITH display^.viewPos DO
  649.       x:=vx; y:=vy; z:=vz;
  650.     END;
  651.     display^.distanceScreen:=dist;
  652.   END;
  653. END SetCamera;
  654.  
  655.  
  656.  
  657. TYPE RasterPtr          = POINTER TO Raster;
  658.      Raster             = RECORD
  659.        rp               : RastPortPtr;
  660.        tmpRas           : TmpRas;
  661.        mem              : ADDRESS;
  662.        w,h              : INTEGER;
  663.        former           : TmpRasPtr;
  664.      END;
  665.  
  666. VAR rememberRaster : NewRememberPtr;
  667.  
  668. PROCEDURE OpenTmpRas(rp : RastPortPtr) : RasterPtr;
  669. VAR tr : RasterPtr;                    (* aus GraphicsSupport, Sorry! *)
  670.     hd : ADDRESS;
  671. BEGIN
  672.   IF rp#NIL THEN
  673.     tr:=NewAllocRemember(rememberRaster,SIZE(Raster),FALSE);
  674.     IF tr#NIL THEN
  675.       WITH rp^.bitMap^ DO
  676.         hd:=AllocRaster(bytesPerRow*8,rows);
  677.         IF hd#NIL THEN
  678.           tr^.rp:=rp;
  679.           tr^.mem:=hd;
  680.           tr^.w:=bytesPerRow*8; tr^.h:=rows;
  681.           InitTmpRas(tr^.tmpRas,hd,bytesPerRow*rows);
  682.           tr^.former:=rp^.tmpRas;
  683.           rp^.tmpRas:=ADR(tr^.tmpRas);
  684.         ELSE
  685.           CutRememberStructure(rememberRaster,tr,TRUE);
  686.           tr:=NIL;
  687.         END;
  688.       END;
  689.     END;
  690.   END;
  691.   RETURN tr;
  692. END OpenTmpRas;
  693.  
  694.  
  695.  
  696. PROCEDURE CloseTmpRas(rast : RasterPtr);
  697. VAR rem : NewRememberPtr;
  698.     rr  : RasterPtr;
  699.     b   : BOOLEAN;
  700. BEGIN
  701.   IF rast#NIL THEN
  702.     WITH rast^ DO
  703.       IF mem#NIL THEN
  704.         FreeRaster(mem,w,h);
  705.       END;
  706.     END;
  707.     b:=TRUE;
  708.     rem:=rememberRaster;
  709.     WHILE rem#NIL DO
  710.       rr:=GetAddress(rem);
  711.       IF rr#rast THEN
  712.         IF rr^.former=ADR(rast^.tmpRas) THEN
  713.           rr^.former:=rast^.former;
  714.           b:=FALSE;
  715.         END;
  716.       END;
  717.       rem:=rem^.next;
  718.     END;
  719.     IF b THEN
  720.       rast^.rp^.tmpRas:=rast^.former;
  721.     END;
  722.     CutRememberStructure(rememberRaster,rast,TRUE);
  723.     rast:=NIL;
  724.   END;
  725. END CloseTmpRas;
  726.  
  727.  
  728.  
  729. (*$ EntryExitCode:=FALSE *)
  730. PROCEDURE Swap(i1{0},i2{1} : LONGINT;
  731.                adr{10}     : ADDRESS);
  732. BEGIN
  733.   ASSEMBLE(
  734.     LSL.L #2,D0
  735.     LSL.L #2,D1
  736.     MOVE.L A2,A1
  737.     ADD.L D0,A1
  738.     ADD.L D1,A2
  739.     MOVE.L (A1),D0
  740.     MOVE.L (A2),(A1)
  741.     MOVE.L D0,(A2)
  742.     RTS
  743.   END);
  744. END Swap;
  745.  
  746.  
  747.  
  748. (*$ EntryExitCode:=FALSE *)
  749. PROCEDURE QuickSort(left{6},right{7}  : LONGINT;
  750.                     adr{10}            : ADDRESS);
  751. BEGIN
  752.   ASSEMBLE(
  753.     MOVEM.L D2-D7,-(SP)
  754.   r1:
  755.     MOVE.L D6,D2
  756.     MOVE.L D7,D3
  757.     MOVE.L D6,D5
  758.     ADD.L D7,D5
  759.     LSL.L #1,D5
  760.     AND.L #$FFFFFFFC,D5
  761.     MOVE.L D5,A0
  762.     ADD.L A2,A0
  763.     MOVE.L (A0),A0
  764.     MOVE.L Object.pz(A0),D4
  765.   r2:
  766.   w1:
  767.     MOVE.L A2,A0
  768.     MOVE.L D2,D5
  769.     LSL.L #2,D5
  770.     ADD.L D5,A0
  771.     MOVE.L (A0),A0
  772.     MOVE.L Object.pz(A0),D1
  773.     MOVE.L D4,D0
  774.     JSR Cmp(A6)
  775.     BLE ausw1
  776.     ADDQ.L #1,D2
  777.     BRA w1
  778.   ausw1:
  779.   w2:
  780.     MOVE.L A2,A0
  781.     MOVE.L D3,D5
  782.     LSL.L #2,D5
  783.     ADD.L D5,A0
  784.     MOVE.L (A0),A0
  785.     MOVE.L Object.pz(A0),D0
  786.     MOVE.L D4,D1
  787.     JSR Cmp(A6)
  788.     BLE ausw2
  789.     SUBQ.L #1,D3
  790.     BRA w2
  791.   ausw2:
  792.     CMP.L D3,D2
  793.     BGT endif
  794.     MOVEM.L A1-A2,-(SP)
  795.     MOVE.L D2,D0
  796.     MOVE.L D3,D1
  797.     BSR Swap
  798.     MOVEM.L (SP)+,A1-A2
  799.     ADDQ.L #1,D2
  800.     SUBQ.L #1,D3
  801.     endif:
  802.     CMP.L D3,D2
  803.     BLE r2
  804.     MOVE.L D7,D0
  805.     MOVE.L D2,D1
  806.     CMP.L D2,D7
  807.     BLE endif2
  808.     MOVEM.L D2-D7,-(SP)
  809.     MOVE.L D2,D6
  810.     BSR QuickSort
  811.     MOVEM.L (SP)+,D2-D7
  812.   endif2:
  813.     MOVE.L D3,D7
  814.     CMP.L D7,D6
  815.     BLT r1
  816.     MOVEM.L (SP)+,D2-D7
  817.     RTS
  818.   END);
  819. END QuickSort;
  820.  
  821.  
  822.  
  823. (*$ EntryExitCode:=FALSE *)
  824. PROCEDURE SortPList(as{0}   : ADDRESS;
  825.                     pnum{7} : LONGINT);
  826. BEGIN
  827.   ASSEMBLE(
  828.     MOVE.L D6,-(SP)
  829.     MOVE.L A2,-(SP)
  830.     TST.L D0
  831.     BEQ ende
  832.     MOVE.L MathFFP(A4),A6
  833.     MOVE.L D0,A2
  834.     MOVEQ #0,D6
  835.     SUBQ.L #1,D7
  836.     BSR QuickSort
  837.   ende:
  838.     MOVE.L (SP)+,A2
  839.     MOVE.L (SP)+,D6
  840.     RTS
  841.   END);
  842. END SortPList;
  843.  
  844.  
  845.  
  846. CONST WC = 180.0/3.141592653589;
  847.  
  848. PROCEDURE SimpleRender(display : DisplayPtr;
  849.                        rp      : RastPortPtr;
  850.                        flags   : RenderFlagSet);
  851. VAR actObjh  : ObjectHandlePtr;
  852.     actObj   : ObjectPtr;
  853.     actArea  : AreaPtr;
  854.     ai       : AreaInfo;
  855.     mem      : ADDRESS;
  856.     oai      : AreaInfoPtr;
  857.     rt       : RasterPtr;
  858.     alist    : POINTER TO ARRAY[0..16383] OF ObjectPtr;
  859.     p1,p2,op,actSA                      : ObjectPtr;
  860.     xn,yn,zn,cx,cy,cz,vh,vd,pd,hm,lm    : FFP;
  861.     f11,f12,f13,f21,f22,f23,f31,f32,f33 : FFP;
  862.     sy,sx,sz,tx,ty,tz,zz,gy,px,py,pz    : FFP;
  863.     xl,yl,xp,yp,num,nz,mx,my,rx,ry      : INTEGER;
  864. BEGIN
  865.   IF (display#NIL) AND (rp#NIL) THEN
  866.     mem:=NIL;
  867.     IF rp^.bitMap#NIL THEN
  868.       WITH rp^.bitMap^ DO
  869.         mx:=4*bytesPerRow;
  870.         my:=rows/2;
  871.       END;
  872.     END;
  873.     IF hiresMode IN flags THEN hm:=2.0; ELSE hm:=1.0; END;
  874.     IF laceMode IN flags THEN lm:=2.0; ELSE lm:=1.0; END;
  875.     WITH display^.cameraPos DO
  876.       cx:=x; cy:=y; cz:=z;
  877.     END;
  878.     WITH display^.viewPos DO
  879.       cx:=cx-x; cy:=cy-y; cz:=cz-z;
  880.       px:=x; py:=y; pz:=z;
  881.     END;
  882.     vd:=Sqrt(cx*cx+cy*cy+cz*cz);
  883.  
  884.     IF cz=0.0 THEN
  885.       ry:=0;
  886.     ELSE
  887.       ry:=TRUNC(Atan(cx/cz)*WC);
  888.     END;
  889.     IF cz<0.0 THEN INC(ry,180); END;
  890.  
  891.     pd:=Sqrt(cz*cz+cx*cx);
  892.  
  893.     IF pd=0.0 THEN
  894.       rx:=90;
  895.     ELSE
  896.       rx:=-TRUNC(Atan(cy/pd)*WC);
  897.     END;
  898.  
  899.     vh:=display^.distanceScreen;
  900.     IF hiddenLine IN flags THEN
  901.       num:=0;
  902.       actObjh:=display^.firstObject;
  903.       WHILE actObjh#NIL DO
  904.         actObj:=actObjh^.firstArea;
  905.         WHILE actObj#NIL DO
  906.           INC(num);
  907.           actObj:=actObj^.nextArea;
  908.         END;
  909.         actObjh:=actObjh^.nextObject;
  910.       END;
  911.       AllocMem(alist,SIZE(ObjectPtr)*(num+2),FALSE);
  912.       rt:=OpenTmpRas(rp);
  913.       IF rt#NIL THEN
  914.         AllocMem(mem,258*5,TRUE);
  915.         IF mem#NIL THEN
  916.           InitArea(ai,mem,256);
  917.           oai:=rp^.areaInfo;
  918.           rp^.areaInfo:=ADR(ai);
  919.           INCL(rp^.flags,areaOutline);
  920.           num:=0;
  921.           actObjh:=display^.firstObject;
  922.           WHILE actObjh#NIL DO
  923.             actObj:=actObjh^.firstArea;
  924.             WITH actObjh^ DO
  925.               cx:=Cos(rotX+rx);
  926.               sx:=Sin(rotX+rx);
  927.               cy:=Cos(rotY+ry);
  928.               sy:=Sin(rotY+ry);
  929.               cz:=Cos(rotZ);
  930.               sz:=Sin(rotZ);
  931.             END;
  932.             WITH actObjh^.trans DO
  933.               tx:=x; ty:=y; tz:=z;
  934.             END;
  935.             f11:=cy*cz; f12:=cy*sz; f13:=-sy;
  936.             f21:=sx*sy*cz-cx*sz; f22:=sx*sy*sz+cx*cz; f23:=sx*cy;
  937.             f31:=cx*sy*cz+sx*sz; f32:=cx*sy*sz-sx*cz; f33:=cx*cy;
  938.             WHILE actObj#NIL DO
  939.               alist^[num]:=actObj;
  940.               IF alist^[num]#NIL THEN
  941.                 zz:=0.0; nz:=0;
  942.                 p1:=NIL; p2:=NIL; op:=NIL;
  943.                 actArea:=actObj^.firstPoint;
  944.                 WHILE actArea#NIL DO
  945.                   WITH actArea^.point DO
  946.                     xn:=x*f11+y*f12+z*f13+tx-px;
  947.                     yn:=x*f21+y*f22+z*f23+ty-py;
  948.                     zn:=x*f31+y*f32+z*f33+tz-pz;
  949.                   END;
  950.                   WITH actArea^ DO
  951.                     x:=TRUNC((xn*vh*hm)/(vd-zn));
  952.                     y:=TRUNC((yn*vh*lm)/(vd-zn));
  953.                     zz:=zz+zn; INC(nz);
  954.                     actArea:=actArea^.nextPoint;
  955.                   END;
  956.                 END;
  957.                 IF nz>0 THEN
  958.                   alist^[num]^.pz:=zz/FFP(nz);
  959.                 ELSE
  960.                   alist^[num]^.pz:=0.0;
  961.                 END;
  962.                 INC(num);
  963.               END;
  964.               actObj:=actObj^.nextArea;
  965.             END;
  966.             actObjh:=actObjh^.nextObject;
  967.           END;
  968.           SortPList(alist,num);
  969.  
  970.           ASSEMBLE(
  971.             MOVEM.L D2-D4/A2-A3,-(SP)
  972.             MOVE.L GraphicsL(A4),A6
  973.             MOVE.L alist(A5),A3
  974.           for:
  975.             MOVE.L (A3),A2
  976.             CMP.L #0,A2
  977.             BEQ endfor
  978.             MOVE.L rp(A5),A1
  979.             MOVE.W Object.lineColor(A2),D0
  980.             MOVE.B D0,RastPort.aOlPen(A1)
  981.             MOVEQ #0,D0
  982.             MOVE.W Object.innerColor(A2),D0
  983.             JSR SetAPen(A6)
  984.             MOVE.L Object.firstPoint(A2),A2
  985.             CMP.L #0,A2
  986.             BEQ endif
  987.             MOVE.W Area.x(A2),D0
  988.             ADD.W mx(A5),D0
  989.             MOVE.W my(A5),D1
  990.             SUB.W Area.y(A2),D1
  991.             MOVE.L rp(A5),A1
  992.             JSR AreaMove(A6)
  993.             MOVE.L Area.nextPoint(A2),A2
  994.           endif:
  995.           w1:
  996.             CMP.L #0,A2
  997.             BEQ wende1
  998.             MOVE.W Area.x(A2),D0
  999.             ADD.W mx(A5),D0
  1000.             MOVE.W my(A5),D1
  1001.             SUB.W Area.y(A2),D1
  1002.             MOVE.L rp(A5),A1
  1003.             JSR AreaDraw(A6)
  1004.             MOVE.L Area.nextPoint(A2),A2
  1005.             BRA w1
  1006.           wende1:
  1007.             MOVE.L rp(A5),A1
  1008.             JSR AreaEnd(A6)
  1009.             ADDQ.L #4,A3
  1010.             BRA for
  1011.           endfor:
  1012.           MOVEM.L (SP)+,D2-D4/A2-A3
  1013.           END);
  1014.  
  1015.           Deallocate(mem);
  1016.         END;
  1017.         CloseTmpRas(rt);
  1018.       END;
  1019.       Deallocate(alist);
  1020.     ELSE
  1021.       actObjh:=display^.firstObject;
  1022.       WHILE actObjh#NIL DO
  1023.         actObj:=actObjh^.firstArea;
  1024.         WITH actObjh^ DO
  1025.           cx:=Cos(rotX+rx);
  1026.           sx:=Sin(rotX+rx);
  1027.           cy:=Cos(rotY+ry);
  1028.           sy:=Sin(rotY+ry);
  1029.           cz:=Cos(rotZ);
  1030.           sz:=Sin(rotZ);
  1031.         END;
  1032.         WITH actObjh^.trans DO
  1033.           tx:=x; ty:=y; tz:=z;
  1034.         END;
  1035.         f11:=cy*cz; f12:=cy*sz; f13:=-sy;
  1036.         f21:=sx*sy*cz-cx*sz; f22:=sx*sy*sz+cx*cz; f23:=sx*cy;
  1037.         f31:=cx*sy*cz+sx*sz; f32:=cx*sy*sz-sx*cz; f33:=cx*cy;
  1038.         WHILE actObj#NIL DO
  1039.           SetAPen(rp,actObj^.lineColor);
  1040.           actArea:=actObj^.firstPoint;
  1041.           IF actArea#NIL THEN
  1042.             WITH actArea^.point DO
  1043.               xn:=x*f11+y*f12+z*f13+tx-px;
  1044.               yn:=x*f21+y*f22+z*f23+ty-py;
  1045.               zn:=x*f31+y*f32+z*f33+tz-pz;
  1046.             END;
  1047.             xp:=TRUNC((xn*vh*hm)/(vd-zn));
  1048.             yp:=TRUNC((yn*vh*lm)/(vd-zn));
  1049.             Move(rp,xp+mx,my-yp);
  1050.           END;
  1051.           WHILE actArea#NIL DO
  1052.             WITH actArea^.point DO
  1053.               xn:=x*f11+y*f12+z*f13+tx-px;
  1054.               yn:=x*f21+y*f22+z*f23+ty-py;
  1055.               zn:=x*f31+y*f32+z*f33+tz-pz;
  1056.             END;
  1057.             xl:=TRUNC((xn*vh*hm)/(vd-zn));
  1058.             yl:=TRUNC((yn*vh*lm)/(vd-zn));
  1059.             Draw(rp,xl+mx,my-yl);
  1060.             actArea:=actArea^.nextPoint;
  1061.           END;
  1062.           Draw(rp,xp+mx,my-yp);
  1063.           actObj:=actObj^.nextArea;
  1064.         END;
  1065.         actObjh:=actObjh^.nextObject;
  1066.       END;
  1067.     END;
  1068.   END;
  1069. END SimpleRender;
  1070.  
  1071.  
  1072.  
  1073. PROCEDURE FreeObject(    display : DisplayPtr;
  1074.                      VAR object  : ObjectHandlePtr);
  1075. VAR t,o : ObjectHandlePtr;
  1076. BEGIN
  1077.   IF object#NIL THEN
  1078.     IF object^.rememberData#NIL THEN
  1079.       FreeRemember(ADR(object^.rememberData),TRUE);
  1080.     END;
  1081.     o:=NIL;
  1082.     IF display#NIL THEN
  1083.       IF display^.firstObject=object THEN
  1084.         display^.firstObject:=object^.nextObject;
  1085.       ELSE
  1086.         t:=display^.firstObject;
  1087.         WHILE t#NIL DO
  1088.           IF t=object THEN
  1089.             IF o#NIL THEN
  1090.               o^.nextObject:=t^.nextObject;
  1091.             END;
  1092.           END;
  1093.           o:=t;
  1094.           t:=t^.nextObject;
  1095.         END;
  1096.       END;
  1097.     END;
  1098.     CutRememberStructure(rememberObject,object,TRUE);
  1099.   END;
  1100.   object:=NIL;
  1101. END FreeObject;
  1102.  
  1103.  
  1104.  
  1105. PROCEDURE FreeDisplay(VAR display : DisplayPtr);
  1106. VAR t,d : ObjectHandlePtr;
  1107. BEGIN
  1108.   IF display#NIL THEN
  1109.     t:=display^.firstObject;
  1110.     WHILE t#NIL DO
  1111.       d:=t;
  1112.       FreeObject(NIL,d);
  1113.       t:=t^.nextObject;
  1114.     END;
  1115.     CutRememberStructure(rememberDisplay,display,TRUE);
  1116.   END;
  1117.   display:=NIL;
  1118. END FreeDisplay;
  1119.  
  1120.  
  1121.  
  1122. VAR obj : ObjectHandlePtr;
  1123.     mem : ADDRESS;
  1124.     rem : NewRememberPtr;
  1125.     ras : RasterPtr;
  1126.  
  1127. BEGIN
  1128.  
  1129.   sinus:=ADR(SinusTable);
  1130.  
  1131. CLOSE
  1132.  
  1133.   rem:=rememberRaster;
  1134.   WHILE rem#NIL DO
  1135.     ras:=GetAddress(rem);
  1136.     CloseTmpRas(ras);
  1137.     rem:=rem^.next;
  1138.   END;
  1139.   NewFreeRemember(rememberRaster,TRUE);
  1140.  
  1141.  
  1142.   rem:=rememberObject;
  1143.   WHILE rem#NIL DO
  1144.     obj:=GetAddress(rem);
  1145.     IF obj#NIL THEN
  1146.       IF obj^.rememberData#NIL THEN
  1147.         FreeRemember(ADR(obj^.rememberData),TRUE);
  1148.       END;
  1149.     END;
  1150.     rem:=rem^.next;
  1151.   END;
  1152.   NewFreeRemember(rememberObject,TRUE);
  1153.  
  1154.   NewFreeRemember(rememberDisplay,TRUE);
  1155.  
  1156. END Simple3D.
  1157.